home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
SunSoft Catalyst CDWARE 1996 May to August
/
Catalyst CDWARE 1996 May to August.iso
/
.products
/
.bin
/
httpd
/
Solaris_2
/
gen.pl
< prev
next >
Wrap
Perl Script
|
1995-07-11
|
8KB
|
292 lines
#!./perl
# ------------------------------------------------------------
# generic_mailer2.pl, by phil hooper (pjh@netcom.com)
#
#####################################################################
#
# Copyright & Disclaimer
# Original bits copyright Creative Dynamics, Inc, oct 1994
# Permission to distribute, use, modify, ridicule granted
# provided the Copyright and Disclaimer stays intact.
#
# This code is provided as-is, with no guarantee that it will
# do anything (or for that matter, there is no guarantee that
# it WON'T do anything, either).
#
#####################################################################
#
# unabashedly swiping code from Reuven M. Lerner and
# and James tappin (see below)...after all, james burke
# says nothing is ever invented, just assembled from bits...
# all this thing does is mail the contents of a form
# to the address specified in the 'mailto' widget
# of the form. the widget names/values are dumped one per line into
# the email in the order they are specified in the form
# definition. widget names and types are irrelevant except
# (of course) for the special cases:
#
# 1] the mailto widget specifies the mail address
#
# e.g. <INPUT NAME="mailto" TYPE="hidden" VALUE="pjh@netcom.com">
#
# 2] any time a widget named "space" is encountered, a blank
# line is inserted in the email instead of the value
# for the field.
#
# e.g. <INPUT NAME="space" TYPE="hidden" VALUE="space">
#
# 3] the request widget is used as the mail subject (sorry
# about 'request'...it was historical).
#
# e.g. <INPUT NAME="request" TYPE="hidden" VALUE="spam order request">
#
# 4] the thanks_url widget can be used to replace the generic thank
# you page with a url you specify
#
# e.g. <INPUT NAME="thanks_url" TYPE="hidden" VALUE="/stuff/thanks.html">
#
# 5] REQUIRED keywords can be added to the widgets NAME to indicate
# a value must be provided.
# if the user did not enter anything into that widget,
# then the form is not mailed and a page is displayed telling the
# user which fields require values (by NAME, so you want the widget
# name to be something obvious...the REQUIRED part is stripped off)
#
# e.g. Your Name : <INPUT NAME="REQUIRED Your Name">
# <BR>
# Your Email: <INPUT NAME="REQUIRED Your Email">
# ---------------------------------------------------------------
# credits
# ---------------------------------------------------------------
# Form-mail.pl, by Reuven M. Lerner (reuven@the-tech.mit.edu).
# This is a rewrite of a program that was trashed by our power
# surge in the middle of February 1994.
# ---------------------------------------------------------------
# The CGI_HANDLERS deal with basic CGI POST or GET method request
# elements such as those delivered by an HTTPD form, i.e. a url
# encoded line of "=" separated key=value pairs separated by &'s
# Routines:
# get_request: reads the request and returns both the raw and
# processed version.
# url_decode: URL decodes a string or array of strings
# html_header: Transmits a HTML header back to the caller
# html_trailer: Transmits a HTML trailer back to the caller
# Author:
# James Tappin: sjt@xun8.sr.bham.ac.uk
# School of Physics & Space Research University of Birmingham
# Feb 1993.
# Copyright & Disclaimer.
# This set of routines may be freely distributed, modified and
# used, provided this copyright & disclaimer remains intact.
# This package is used at your own risk, if it does what you
# want, good; if it doesn't, modify it or use something else--but
# don't blame me. Support level = negligable (i.e. mail bugs but
# not requests for extensions)
# Usage:
# &get_request; will get the request and decode it into an
# indexed array %rqpairs, the raw request is in
# $request
#
# ... = &url_decode(LIST); will return a URL decoded version of
# the contents of LIST
#
sub get_request {
# Subroutine get_request reads the POST or GET form request from STDIN
# into the variable $request, and then splits it into its
# name=value pairs in the associative array %rqpairs.
# The number of bytes is given in the environment variable
# CONTENT_LENGTH which is automatically set by the request generator.
# Encoded HEX values and spaces are decoded in the values at this
# stage.
# $request will contain the RAW request. N.B. spaces and other
# special characters are not handler in the name field.
if ($ENV{'REQUEST_METHOD'} eq "POST") {
read(STDIN, $request, $ENV{'CONTENT_LENGTH'});
} elsif ($ENV{'REQUEST_METHOD'} eq "GET" ) {
$request = $ENV{'QUERY_STRING'};
}
@names = &url_decode(split(/[&=]/, $request));
%rqpairs = @names;
}
sub url_decode {
# Decode a URL encoded string or array of strings
# + -> space
# %xx -> character xx
foreach (@_) {
tr/+/ /;
s/%(..)/pack("c",hex($1))/ge;
}
@_;
}
sub html_header {
# Subroutine html_header sends to Standard Output the necessary
# material to form an HHTML header for the document to be
# returned, the single argument is the TITLE field.
local($title) = @_;
print "Content-type: text/html\n\n";
print "<html><head>\n";
print "<title>$title</title>\n";
print "</head>\n<body>\n";
}
sub html_trailer {
# subroutine html_trailer sends the trailing material to the HTML
# on STDOUT.
local($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst)
= gmtime;
local($mname) = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul",
"Aug", "Sep", "Oct", "Nov", "Dec")[$mon];
local($dname) = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri",
"Sat")[$wday];
print "<p>\nGenerated by: <var>$0</var><br>\n";
print "Date: $hour:$min:$sec UT on $dname $mday $mname $year.<p>\n";
print "</body></html>\n";
}
#
# --------- Everything above here is generic ---------
#
#
# Define fairly-constants
#
$mailprog = '/usr/ucb/mail';
#
# Get the input, output header
#
&get_request;
#
# make sure nobody tries to execute a subshell
#
$rqpairs{'mailto'} =~ s/~!/ ~!/g;
#
# check for REQUIRED keyword. Set flag if value is required
# but not provided, then put up a page and forget about sending
# mail
#
@check_reqs = @names;
for $i (0..$#check_reqs){
$name = shift(@check_reqs);
$value = shift(@check_reqs);
if ($name =~ /REQUIRED/) {
if ($value eq "") {
$bad = $name;
$bad =~ s/\s*REQUIRED\s*//;
push(@missing, $bad);
}
}
}
if ($#missing >= 0) {
&html_header('Generic Mailer (by pjh@netcom.com)');
print "<H1>Missing Required Information</H1>\n";
print "<HR>\n";
print "<H3>Please provide values for the following:</H3>\n";
print "<UL>\n";
for $i (0..$#missing) {
$field = shift(@missing);
print "<LI> $field\n";
}
print "</UL>\n";
print "<HR>\n";
print "<H3>Go back and try again</H3>\n";
&html_trailer;
exit 0;
}
#
# Now send mail to $rqpairs{'mailto'};
#
open (MAIL, "|$mailprog -s \"$rqpairs{'request'}\" $rqpairs{'mailto'}") || die "Can't open $mailprog!\n";
print MAIL "------------------------------------------------------------\n\n";
for $i (0..$#names){
$name = shift(@names);
$value = shift(@names);
$i++;
if (($name ne "") && ($name ne 'mailto') && ($name ne 'thanks_url')) {
if ($name ne "space") {
#
# be a little tidier if the $value has an embedded newline, print the
# whole thing starting on a seperate line.
#
$name =~ s/\s*REQUIRED\s*//;
if ($value =~ /\n/) {
print MAIL "[$name]: (below)\n$value\n";
} else {
print MAIL "[$name]: $value\n";
}
} else {
print MAIL "\n";
}
}
}
print MAIL "\n------------------------------------------------------------\n\n";
print MAIL "Remote host: $ENV{'REMOTE_HOST'}\n";
print MAIL "Remote IP address: $ENV{'REMOTE_ADDR'}\n";
close (MAIL);
#
# if they haven't provided a thank-you url, then print the
# default thank you page. if they have provided an url ,then
# issue a redirect
#
if ($rqpairs{'thanks_url'} eq "") {
&html_header('Generic Mailer (by pjh@netcom.com)');
print "<H1>Thank You!</H1>\n";
print "<HR>";
print "Your mail has been sent to <b>[$rqpairs{'mailto'}] </b>";
&html_trailer;
} else {
print "Location: $rqpairs{'thanks_url'}\n\n";
}